home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 0800 / crtclass.pas next >
Pascal/Delphi Source File  |  1997-04-10  |  2KB  |  69 lines
  1. (* 
  2. Shows how to hook WinCRT's WindowClass.
  3. Public Domain by Mike Caughran
  4. Cedar Island Software 
  5. 71034.2371@compuserve.com
  6. *)
  7.  
  8. program HookCRT;
  9. uses WinCRT, WinTypes, WinProcs;
  10. var
  11.   OldWndProc : TFarProc;
  12. const
  13.   hHookedWnd : HWND = 0;
  14.   cm_Exit    = 100;
  15.   cm_About   = 101;
  16.  
  17. function WindowProc(Window:HWnd; Message,wParam:Word; lParam:LongInt) : LongInt; export;
  18. begin
  19.   case Message of
  20.     wm_char        : if wParam=vk_Return then MessageBeep(0);
  21.     wm_LButtonDown : MessageBox(Window,'Left button','Mouse',MB_OK);
  22.     wm_Command     : begin
  23.       case WParam of
  24.     cm_About:   MessageBox(Window,'Shows how to subclass WinCRT','Hooked CRT',mb_IconExclamation);
  25.     cm_Exit:    DoneWinCrt;
  26.       end;
  27.     end;
  28.   end;
  29.   WindowProc := CallWindowProc(OldWndProc, Window, Message, wParam, lParam);
  30. end;
  31.  
  32. procedure MakeMenu;
  33. var
  34.   Menu      : HMenu;
  35.   FileMenu  : HMenu;
  36. begin
  37.   Menu := CreateMenu;
  38.   FileMenu := CreateMenu;
  39.   AppendMenu(Menu, mf_PopUp or mf_Enabled, FileMenu, 'File');
  40.   AppendMenu(FileMenu, mf_Enabled, cm_Exit, 'Exit');
  41.   AppendMenu(Menu, mf_Enabled, cm_About, 'About');
  42.   SetMenu(hHookedWnd,Menu);
  43. end;
  44.  
  45. procedure myInitWinCRT;
  46. var
  47.   hInstance : THandle;
  48.   WindowClass : TWndClass;
  49. begin
  50.   GetClassInfo(hInstance, 'TPWinCrt' ,WindowClass);
  51.   UnregisterClass('TPWinCRT', hInstance);
  52.   WindowClass.hIcon := LoadIcon(0, idi_Exclamation);
  53.   WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  54.   WindowClass.hbrBackground := CreateSolidBrush(Color_Background);
  55.   OldWndProc := tFarProc(WindowClass.lpfnWndProc);
  56.   WindowClass.lpfnWndProc := @WindowProc;
  57.   RegisterClass(WindowClass);
  58.   InitWinCrt;
  59.   hHookedWnd := GetActiveWindow;
  60.   SetWindowText(hHookedWnd,'Test Sub-Classed WinCRT');
  61.   MakeMenu;
  62. end;
  63.  
  64. begin
  65.   myInitWinCrt;
  66.   Writeln('Welcome to Subclassed WinCRT World!');
  67.   Write('Enter some text : ');  readln;
  68.   DoneWinCrt;
  69. end.